{-
    Copyright © 2011 - 2021, Ingo Wechsung
 *
    All rights reserved.
 *
    Redistribution and use in source and binary forms, with or
    without modification, are permitted provided that the following
    conditions are met:

    -   Redistributions of source code must retain the above copyright
        notice, this list of conditions and the following disclaimer.

    -   Redistributions in binary form must reproduce the above
        copyright notice, this list of conditions and the following
        disclaimer in the documentation and/or other materials provided
        with the distribution. Neither the name of the copyright holder
        nor the names of its contributors may be used to endorse or
        promote products derived from this software without specific
        prior written permission.

    *THIS SOFTWARE IS PROVIDED BY THE
    COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR
    IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
    WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER
    OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
    SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
    LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF
    USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED
    AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING
    IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
    THE POSSIBILITY OF SUCH DAMAGE.*
-}

{--
 * Support for ad hoc parallelism in Frege through java's ForkJoin mechanism
 -}

module frege.lib.ForkJoin where

infixr 2 par   -- like seq
infixr 1 $|    -- like ($)
infixr 4 :|    -- like (:)

{--
    Native operation to fork evaluation of some lazy value.

    A ForkJoinTask will be created and forked unless
    the value is already evaluated.

    When the ForkJoinTask begins execution it will invoke the @call()@ method
    of the @frege.run.Thunk@ instance that was passed as value.
    Since @Lazy@ implements the
    Java @Callable@ interface, it just evaluates the lazy value in the
    usual way. Because evaluation is synchronized, any attempts to evaluate the
    value from other tasks will block until evaluation is complete and the
    @Thunk@ is updated.

    We pass the value as Thunk to avoid premature evaluation.
 -}
private pure native fork  ForkJoin.fork {a}   :: (a, Bool) -> Bool
private pure native fork2 ForkJoin.fork2{a,b} :: (a, b)    -> Bool 

native module where {
    // -- We get a tuple (a,b), where a is the value that must be evaluated.
    // -- We extract a, which must be a Thunk.
    private static<A> boolean fork(final PreludeBase.TTuple2<A,Boolean> it) {
        return frege.run.Concurrent.fork(it.mem1);
    }

    private static<A,B> boolean fork2(final PreludeBase.TTuple2<A,B> it) {
        return frege.run.Concurrent.fork(it.mem2) 
            && frege.run.Concurrent.fork(it.mem1);
    }
}

{--
    > a `par` b

    Fork evaluation of @a@ and return @b@.
 -}
par ?a ?b = if fork (a, true) then b else undefined

{--
    > f $| a
 
    Equivalent to 

    > a `par` f a

    Is useful only if @f@ takes a lazy argument, otherwise the thunk will be evaluated right away.
-}
f $| ?a = a `par` f a

{--
    >   parOp f a b

    Equivalent to 

    > a `par` (b `par` f a b)

    The function should be lazy in both arguments.
 -}
parOp f ?a ?b = if fork2 (a, b) then f a b else undefined

{--
    > a :| as

    Equivalent to 

    > parOp (:) a as
-}
?a :| ?as = parOp (:) a as

{--
    > mapP f xs

    Like 'map', but applies the function parallel to mapping the rest of the list.
    It does therefore not work with infinite lists.
-}
mapP f (x:xs) = parOp (:) (f x) (mapP f xs)
mapP f [] = []
